home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Delphi / Duck Report / _SETUP.1 / DQQField.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-12-16  |  13.0 KB  |  477 lines
  1. Unit DQQField;
  2.  
  3. Interface
  4.  
  5. Uses
  6.     Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   DB, DBTables, StdCtrls;
  8. Const
  9.     TITLE_HEIGHT    = 20;
  10.   D_HEIGHT            = 200;
  11.   D_WIDTH            = 120;
  12. Type
  13.     TQueryField    = Class;
  14.     { ---------- TDQFieldListBox ---------- }
  15.     TDQFieldListBox = Class (TListBox)
  16.   Private
  17.     Protected
  18.         iOldTopIndex:    Integer;
  19.      FQueryField:    TQueryField;
  20.         Procedure    WMHScroll (var Message: TWMHScroll); message WM_HSCROLL;
  21.         Procedure    WMVScroll (var Message: TWMVScroll); message WM_VSCROLL;
  22.      Procedure    DrawItem (Index: Integer; Rect: TRect; State: TOwnerDrawState); Override;
  23.   Public
  24.       Constructor    Create (AOwner: TComponent); Override;
  25.         Destructor    Destroy; Override;
  26.      Procedure    SetSelectIndex (Index: Integer; bValue: Boolean);
  27.  
  28.      Property        QueryField:        TQueryField Read FQueryField Write FQueryField;
  29.   Published
  30.     End;
  31.  
  32.     { ---------- TQueryField ---------- }  
  33.   TQueryField = Class (TCustomControl)
  34.     Private
  35.     Protected
  36.       StDatabase:    String;
  37.      StTable:        String;
  38.  
  39.         StMDataBase:    String;
  40.         StMTableName:    String;
  41.      StMAlias:        String;
  42.         StMField:        String;
  43.      FMCtrl:            TControl;
  44.  
  45.         StDDataBase:    String;
  46.         StDTableName:    String;
  47.      StDAlias:        String;
  48.         StDField:        String;
  49.      FDCtrl:            TControl;
  50.      FStartMove:        Boolean;
  51.  
  52.       ColorTitle:    TColor;
  53.      FListBox:    TDQFieldListBox;
  54.      OldIndex:    Integer;
  55.      FOnReSize:    TNotifyEvent;
  56.      FOnAddLink:    TNotifyEvent;
  57.  
  58.         Procedure    WMGetMinMaxInfo (Var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  59.         Procedure    WMNCHitTest (Var Message: TWMNCHitTest); message WM_NCHITTEST;
  60.      Procedure    WMSize (Var Message: TWMSize); message WM_SIZE;
  61.      Procedure    WMMove (Var Message: TWMMove); message WM_MOVE;
  62.      Procedure    Paint; Override;
  63.         Procedure    ListBoxDrawItem (Control: TWinControl; Index: Integer;
  64.                         Rect: TRect; State: TOwnerDrawState);
  65.         Procedure    ListBoxDragDrop (Sender, Target: TObject; X, Y: Integer);
  66.      Procedure    ListBoxDragOver (Sender, Source: TObject; X, Y: Integer;
  67.                         State: TDragState; var Accept: Boolean);
  68.     Public
  69.       Constructor    Create (AOwner: TComponent); Override;
  70.         Destructor    Destroy; Override;
  71.      Procedure    SetDataBase (p_StDatabase, p_StTable: String);
  72.      Procedure    SetDataBaseField (p_StDatabase, p_StTable: String;
  73.                      Fields: TStrings);
  74.      Procedure    SetListBoxSize;
  75.      Function        GetPosition (StField: String): Integer;
  76.  
  77.      Procedure    GetField (Items: TStrings);
  78.  
  79.      Property        ListBox:        TDQFieldListBox Read FListBox;
  80.      Property        DataBase:    String Read StDatabase Write StDatabase;
  81.      Property        TableName:    String Read StTable Write StTable;
  82.  
  83.      Property        MDataBase:    String Read StMDataBase;
  84.         Property        MTableName:    String Read StMTableName;
  85.      Property        MAlias:        String Read StMAlias;
  86.         Property        MField:        String Read StMField;
  87.      Property        MCtrl:        TControl Read FMCtrl;
  88.  
  89.         Property        DDataBase:    String Read StDDataBase;
  90.         Property        DTableName:    String Read StDTableName;
  91.      Property        DAlias:        String Read StDAlias;
  92.         Property        DField:        String Read StDField;
  93.      Property        DCtrl:        TControl Read FDCtrl;
  94.     Published
  95.       Property        Font;
  96.         Property        Caption;
  97.      Property        OnResize:    TNotifyEvent Read FOnReSize Write FOnReSize;
  98.      Property        OnAddLink:    TNotifyEvent Read FOnAddLink Write FOnAddLink;
  99.      Property        StartMove:    Boolean Read FStartMove Write FStartMove;
  100.     End;
  101.  
  102.  
  103. Implementation
  104.  
  105. { ---------- TDQFieldListBox ---------- }
  106. Constructor TDQFieldListBox.Create (AOwner: TComponent);
  107. Begin
  108.     inherited Create (AOwner);
  109.   iOldTopIndex    := -1;
  110.   FQueryField        := nil;
  111.   Style                := lbOwnerDrawFixed;
  112. End;
  113. Destructor TDQFieldListBox.Destroy;
  114. Begin
  115.     inherited Destroy;
  116. End;
  117. Procedure TDQFieldListBox.WMHScroll (var Message: TWMHScroll);
  118. Begin
  119.     inherited;
  120.   if FQueryField = nil Then Exit;
  121.   if (iOldTopIndex = -1) or (iOldTopIndex <> TopIndex) Then
  122.   Begin
  123.       TopIndex    := iOldTopIndex;
  124.      {$IFDEF WIN32}
  125.      if Assigned (FQueryField.OnResize) Then
  126.           FQueryField.OnResize (FQueryField);
  127.      {$ELSE}
  128.         SendMessage (FQueryField.Handle, WM_SIZE, 0, 0);
  129.      {$ENDIF}
  130.   End;
  131. End;
  132. Procedure TDQFieldListBox.WMVScroll (var Message: TWMVScroll);
  133. Begin
  134.     inherited;
  135.   if FQueryField = nil Then Exit;
  136.   if (iOldTopIndex = -1) or (iOldTopIndex <> TopIndex) Then
  137.   Begin
  138.      {$IFDEF WIN32}
  139.      TopIndex    := iOldTopIndex;
  140.      if Assigned (FQueryField.OnResize) Then
  141.           FQueryField.OnResize (FQueryField);
  142.      {$ELSE}
  143.         SendMessage (FQueryField.Handle, WM_SIZE, 0, 0); 
  144.      {$ENDIF}
  145.   End;
  146. End;
  147. Procedure TDQFieldListBox.SetSelectIndex (Index: Integer; bValue: Boolean);
  148. Begin
  149.     Items.Objects[Index]    := TObject (bValue);
  150.   Invalidate;
  151. End;
  152. Procedure TDQFieldListBox.DrawItem (Index: Integer; Rect: TRect; State: TOwnerDrawState);
  153. Var
  154.     bValue:    Boolean;
  155. Begin
  156.     bValue    := Boolean (Items.Objects[Index]);
  157.     if bValue Then
  158.   Begin
  159.         Canvas.Brush.Color    := clRed;
  160.      Canvas.Font.Color        := clWhite;
  161.   End
  162.   Else
  163.   Begin
  164.       Canvas.Brush.Color    := clWhite;
  165.      Canvas.Font.Color        := clBlack;
  166.   End;
  167.     Canvas.FillRect(Rect);
  168.     if Index < Items.Count then
  169.         Canvas.TextOut (Rect.Left + 2, Rect.Top, Items[Index]);
  170. End;
  171. { ---------- TQueryField ---------- }
  172. Constructor TQueryField.Create (AOwner: TComponent);
  173. Begin
  174.     inherited Create (AOwner);
  175.   FStartMove        := FALSE;
  176.   ControlStyle    := [csAcceptsControls, csCaptureMouse, csClickEvents,
  177.     csSetCaption, csDoubleClicks];
  178.   Color        := clSilver;
  179.   Height    := D_HEIGHT;
  180.     Width        := D_WIDTH;
  181.   ColorTitle    := clNavy;
  182.   Caption        := '';
  183.   FListBox                    := TDQFieldListBox.Create (Self);
  184.   FListBox.QueryField    := Self;
  185.   FListBox.Parent        := Self;
  186.   FListBox.Style            := lbOwnerDrawFixed;
  187.   FListBox.OnDrawItem    := ListBoxDrawItem;
  188.     FListBox.DragMode        := dmAutomatic;
  189.   FListBox.OnDragDrop    := ListBoxDragDrop;
  190.   FListBox.OnDragOver    := ListBoxDragOver;
  191.     OldIndex                    := -1;
  192.   Visible                    := FALSE;
  193. End;
  194. Destructor TQueryField.Destroy;
  195. Begin
  196.     FListBox.Free;
  197.     inherited Destroy;
  198. End;
  199. Procedure TQueryField.Paint;
  200. Var
  201.     TRc:        TRect;
  202.   iTemp:    Integer;
  203. Begin
  204.     TRc    := ClientRect;
  205.   Dec (TRc.Right);
  206.   Dec (TRc.Bottom);
  207.   Canvas.Pen.Color    := clSilver;
  208.     Canvas.MoveTo (TRc.Left, TRc.Bottom);
  209.   Canvas.LineTo (TRc.Left, TRc.Top);
  210.   Canvas.LineTo (TRc.Right, TRc.Top);
  211.   Canvas.Pen.Color    := clBlack;
  212.   Canvas.LineTo (TRc.Right, TRc.Bottom);
  213.   Canvas.LineTo (TRc.Left, TRc.Bottom);
  214.  
  215.   Inc (TRc.Left);
  216.   Inc (TRc.Top);
  217.   Dec (TRc.Right);
  218.   Dec (TRc.Bottom);
  219.   Canvas.Pen.Color    := clWhite;
  220.     Canvas.MoveTo (TRc.Left, TRc.Bottom);
  221.   Canvas.LineTo (TRc.Left, TRc.Top);
  222.   Canvas.LineTo (TRc.Right, TRc.Top);
  223.   Canvas.Pen.Color    := clGray;
  224.   Canvas.LineTo (TRc.Right, TRc.Bottom);
  225.   Canvas.LineTo (TRc.Left, TRc.Bottom);
  226.  
  227.   Inc (TRc.Left, 3);
  228.   Inc (TRc.Top, 3);
  229.   Dec (TRc.Right, 2);
  230.     TRc.Bottom    := TRc.Top + TITLE_HEIGHT;
  231.  
  232.   Canvas.Brush.Color    := ColorTitle;
  233.   Canvas.Font.Assign (Self.Font);
  234.   Canvas.FillRect (TRc);
  235.   Canvas.Font.Color    := clWhite;
  236.  
  237.   iTemp        := Length (Caption);
  238.   if iTemp > 0 Then
  239. //      PaintTextStr (Canvas, TRc, taCenter, FALSE, Caption);
  240.          DrawText (Canvas.Handle, PChar (Caption), iTemp, TRc,
  241.             DT_CENTER OR DT_VCENTER OR DT_SINGLELINE);
  242. End;
  243. Procedure TQueryField.WMGetMinMaxInfo (Var Message: TWMGetMinMaxInfo);
  244. Begin
  245.     With Message.MinMaxInfo^ Do
  246.     Begin
  247.         ptMinTrackSize.X := 50;
  248.         ptMinTrackSize.Y := TITLE_HEIGHT + 8;
  249.   End;
  250.     Message.Result := 0;
  251.   {Tell windows you have changed  minmaxinfo}
  252.   inherited;
  253. End;
  254. Procedure TQueryField.WMNCHitTest (Var Message :TWMNCHitTest);
  255. Var
  256.     pt:    TPoint;
  257.   iSpace:    Integer;
  258. Begin
  259.     iSpace    := 10;
  260.     pt.x    := Message.XPos;
  261.   pt.y    := Message.YPos;
  262.     pt    := ScreenToClient (pt);
  263.   if (pt.x >= 0) and (pt.x <= iSpace) and (pt.y >= 0) and (pt.y <= iSpace) Then
  264.   Begin
  265.         Message.Result    := HTTOPLEFT;
  266.      Exit;
  267.   End;
  268.     if (pt.x >= Width - iSpace) and (pt.x <= Width) and (pt.y >= 0) and (pt.y <= 5) Then
  269.     Begin
  270.         Message.Result    := HTTOPRIGHT;
  271.      Exit;
  272.   End;
  273.   if (pt.x >= Width - iSpace) and (pt.x <= Width) and (pt.y >= Height - iSpace) and (pt.y <= Height) Then
  274.     Begin
  275.         Message.Result    := HTBOTTOMRIGHT;
  276.      Exit;
  277.   End;
  278.   if (pt.x >= 0) and (pt.x <= iSpace) and (pt.y >= Height - iSpace) and (pt.y <= Height) Then
  279.   Begin
  280.         Message.Result    := HTBOTTOMLEFT;
  281.      Exit;
  282.   End;
  283.  
  284.   iSpace    := 5;
  285.   if (pt.y >= 0) and (pt.y <= iSpace) Then
  286.   Begin
  287.         Message.Result    := HTTOP;
  288.      Exit;
  289.   End;
  290.   if (pt.y >= Height - iSpace) and (pt.y <= Height) Then
  291.   Begin
  292.         Message.Result    := HTBOTTOM;
  293.      Exit;
  294.   End;
  295.   if (pt.x >= 0) and (pt.x <= iSpace) Then
  296.   Begin
  297.         Message.Result    := HTLEFT;
  298.      Exit;
  299.   End;
  300.   if (pt.x >= Width - iSpace) and (pt.x <= Width) Then
  301.   Begin
  302.         Message.Result    := HTRIGHT;
  303.      Exit;
  304.   End;
  305.  
  306.     if (pt.y >= 0) and (pt.y <= TITLE_HEIGHT + 4) Then
  307.       Message.Result    := HTCAPTION
  308.   Else
  309.       Message.Result    := HTCLIENT;
  310.   Message.Result    := HTCAPTION
  311. End;
  312. Procedure TQueryField.WMSize (Var Message: TWMSize);
  313. Begin
  314.     if not FStartMove Then Exit;
  315.     SetListBoxSize;
  316.   if Assigned (FOnResize) Then
  317.       FOnResize (Self);
  318. End;
  319. Procedure TQueryField.SetListBoxSize;
  320. Begin
  321.     FListBox.Left        := 4;
  322.   FListBox.Top        := TITLE_HEIGHT + 6;
  323.   FListBox.Width        := Width - 8;
  324.   FListBox.Height    := Height - TITLE_HEIGHT - 10;
  325. End;
  326. Procedure TQueryField.WMMove (Var Message: TWMMove);
  327. Begin
  328.     if FStartMove Then
  329.       if Assigned (FOnResize) Then
  330.           FOnResize (Self);
  331. End;
  332. Procedure TQueryField.SetDataBaseField (p_StDatabase, p_StTable: String;
  333.                      Fields: TStrings);
  334. Begin
  335.     StDatabase    := p_StDatabase;
  336.   if Fields <> nil Then
  337.   Begin
  338.       FListBox.Items.Assign (Fields);
  339.       FListBox.ItemIndex    := 0;
  340.   End;
  341.     SetListBoxSize;
  342. End;
  343. Procedure TQueryField.SetDataBase (p_StDatabase, p_StTable: String);
  344. Var
  345.     Table:        TTable;
  346.   i:                Integer;
  347.   St:            String;
  348.   bFound:        Boolean;
  349.   Cursor:        TCursor;
  350. Begin
  351.     StDatabase    := p_StDatabase;
  352.   StTable        := p_StTable;
  353.     Table            := TTable.Create (Self);
  354.     {$IFDEF WIN32}
  355.         Table.SessionName        := Session.SessionName;
  356.     {$ENDIF}
  357.  
  358.  
  359.   Table.Databasename    := StDatabase;
  360.   Table.TableName        := StTable;
  361.  
  362.   Cursor            := Screen.Cursor;
  363.   Screen.Cursor    := crHourGlass;
  364.   Try
  365.       Table.Active            := TRUE;
  366.       FListBox.Items.Clear;
  367.       For i := 0 to Table.FieldCount - 1 Do
  368.       Begin
  369.             St            := Table.Fields[i].FieldName;
  370.          bFound    := FALSE;
  371.             FListBox.Items.Add (St);
  372.         End;
  373.   Finally
  374.       Screen.Cursor             := Cursor;
  375.       Table.Active            := FALSE;
  376.         Table.Free;
  377.       FListBox.ItemIndex    := 0;
  378.       SetListBoxSize;
  379.   End;
  380. End;
  381. Procedure TQueryField.ListBoxDrawItem (Control: TWinControl; Index: Integer;
  382.                         Rect: TRect; State: TOwnerDrawState);
  383. Var
  384.     St:    String;
  385.     cl:    LongInt;
  386. Begin
  387.     St    := FListBox.Items.Strings[Index];
  388.     if odSelected in State Then
  389.   Begin
  390.       FListBox.Canvas.Brush.Color    := clNavy;
  391.         FListBox.Canvas.Font.Color    := clWhite;
  392.   End
  393.   Else
  394.   Begin
  395.       FListBox.Canvas.Brush.Color    := clWhite;
  396.         FListBox.Canvas.Font.Color    := clBlack;
  397.   End;
  398.   FListBox.Canvas.FillRect (Rect);
  399.     FListBox.Canvas.TextOut (Rect.Left + 8, Rect.Top, St);
  400. End;
  401. Procedure TQueryField.ListBoxDragDrop (Sender, Target: TObject; X, Y: Integer);
  402. Var
  403.     LBox:        TDQFieldListBox;
  404.     iSelect:    Integer;
  405.     QF:        TQueryField;
  406. Begin
  407.     LBox                := TDQFieldListBox(Sender);
  408.   iSelect            := LBox.ItemAtPos (Point (x, y), TRUE);
  409.   LBox.SetSelectIndex (iSelect, TRUE);
  410.     QF                    := TQueryField (LBox.Parent);
  411.   StDDataBase        := QF.DataBase;
  412.     StDTableName    := QF.TableName;
  413.     StDAlias            := QF.Caption;
  414.     StDField            := QF.ListBox.Items[iSelect];
  415.     FDCtrl            := QF;
  416.   LBox                := TDQFieldListBox(Target);
  417.   QF                    := TQueryField (LBox.Parent);
  418.   StMDataBase        := QF.DataBase;
  419.     StMTableName    := QF.TableName;
  420.   StMAlias            := QF.Caption;
  421.     StMField            := QF.ListBox.Items[QF.ListBox.ItemIndex];
  422.   LBox.SetSelectIndex (QF.ListBox.ItemIndex, TRUE);
  423.   LBox.Invalidate;
  424.   FMCtrl            := QF;
  425.   if Assigned (FOnAddLink) Then
  426.       FOnAddLink (Self);
  427. End;
  428. Procedure TQueryField.ListBoxDragOver (Sender, Source: TObject; X, Y: Integer;
  429.                         State: TDragState; var Accept: Boolean);
  430. Var
  431.     LBox:        TDQFieldListBox;
  432. Begin
  433.     Accept := Source is TDQFieldListBox;
  434.   if Sender = Source Then
  435.         Accept := FALSE;
  436.   if Accept = FALSE Then Exit;
  437.   LBox        := TDQFieldListBox (Sender);
  438.   if LBox.Parent is TQueryField Then
  439.   Accept := LBox.Parent is TQueryField;
  440. End;
  441. Function TQueryField.GetPosition (StField: String): Integer;
  442. Var
  443.     iFind:    Integer;
  444.     Rc:        TRect;
  445.   RcItem:    TRect;
  446.   i:            Integer;
  447.   St:        String;
  448. Begin
  449.     Rc            := Self.BoundsRect;
  450.     Result    := Rc.Top + (TITLE_HEIGHT div 2) + 2;
  451.   iFind        := -1;
  452.   For i := 0 To FListBox.Items.Count - 1 Do
  453.   Begin
  454.       St    := FListBox.Items.Strings[i];
  455.      if St = StField Then
  456.          iFind    := i;
  457.   End; 
  458.     if iFind < 0 Then Exit;
  459.     if iFind < FListBox.TopIndex Then Exit;
  460.     RcItem    := FListBox.ItemRect (iFind);
  461.     Result    := FListBox.Top + RcItem.Top + (FListBox.ItemHeight div 2); 
  462.   Result    := Self.Top + Result; 
  463. End;
  464. Procedure TQueryField.GetField (Items: TStrings);
  465. Var
  466.     St:    String;
  467.   i:        Integer;
  468. Begin
  469.     Items.Clear;
  470.     For i := 0 To FListBox.Items.Count - 1 Do
  471.   Begin
  472.         St    := FListBox.Items.Strings[i];
  473.      Items.Add (St);
  474.   End;
  475. End;
  476. End.
  477.